VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "FontEnumerator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_CallBack As CallBack
Private NTM As NEWTEXTMETRIC
Private NLF As LOGFONT

#If False Then
Function EnumFontFamProc(ByVal lpNLF As Long, ByVal lpNTM As Long, ByVal FontType As Long, LParam As ListBox) As Long
#Else
Function EnumFontFamProc(ByVal lpNLF As Long, ByVal lpNTM As Long, ByVal FontType As Integer, LParam As ListBox) As Integer
#End If
Dim FaceName As String
    CopyMemory NLF, ByVal lpNLF, Len(NLF)
    CopyMemory NTM, ByVal lpNTM, Len(NTM)
    FaceName = String$(LF_FACESIZE, 0)
    CopyMemory ByVal FaceName, NLF.lfFaceName(0), LF_FACESIZE + 1
    LParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
    EnumFontFamProc = 1
End Function

Private Sub Class_Initialize()
    Set m_CallBack = NewCallBack(CBType_FONTENUMPROC, Me, True)
End Sub

Public Property Get ProcAddress() As Long
    ProcAddress = m_CallBack.ProcAddress
End Property

